perm filename MLIST.F4[MSS,LCS]2 blob sn#134954 filedate 1974-12-08 generic text, type T, neo UTF8
00100		COMMON JA
00200		DIMENSION JA(11,200),JB(7,200),JC(7,200),JD(7,200),JE(7,200),
00300		1 NA(11)
00400	102	U=0
00500	8	K=0
00600		NB=0
00700	 	TYPE 6
00800	6	FORMAT(' NEW FILE OR OLD?'/)	
00900		ACCEPT 10,M
01000		IF(M.EQ.' '.AND.U.EQ.1)GO TO 43
01100	  	TYPE 22
01200	22	FORMAT(' TYPE A FILE NAME UP TO 5 LETTERS LONG.'/)
01300		ACCEPT 23,F
01400	23	FORMAT(A5)
01500		IF(F.EQ.'     ')GO TO 8
01600		IF(M.EQ.'O')GO TO 43
01700	10	FORMAT(A1)
01800	15	TYPE 7
01900	7	FORMAT(' TYPE:NAME ON LINE 1,ADDRESS ON LINES 2,3 AND 4,'/
02000	 	1 ' AND UP TO 7 ONE LETTER LIST NAMES ON LINE 5.'/)
02100		NB=1
02200	2	K=K+1
02300	  	TYPE 3
02400	3	FORMAT(' IF FINISHED TYPE <CR>.'//)
02500		ACCEPT 9,(JA(I,K),I=1,11)
02600	9	FORMAT(5A1,6A5)
02700		IF(JA(1,K).EQ.' ')GO TO 33
02800		ACCEPT 11,(JB(I,K),I=1,7)
02900	11	FORMAT(7A5)
03000		ACCEPT 11,(JC(I,K),I=1,7)
03100		ACCEPT 11,(JE(I,K),I=1,7)
03200		ACCEPT 20,(JD(I,K),I=1,7)
03300	20   	FORMAT(7A1)
03400		GO TO 2
03500	43	IF(LOOKD(F))GO TO 44
03600	    	TYPE 58,F
03700	58	FORMAT(1XA5,' FILE NOT FOUND.'/)
03800		GO TO 102
03900	44	REWIND 1
04000		CALL IFILE(1,F)
04100		READ(1)K,((JB(I,L),I=1,7),L=1,K)
04200		READ(1)((JA(I,L),I=1,11),L=1,K)
04300		READ(1)((JC(I,L),I=1,7),L=1,K)
04400		READ(1)((JE(I,L),I=1,7),L=1,K)
04500		READ(1)((JD(I,L),I=1,7),L=1,K),K
04600	134	TYPE 66
04700	66	FORMAT(' TYPE ADD,CHANGE,DELEAT OR <CR> FOR PRINTOUT.'/)
04800		ACCEPT 10,P
04900		IF(P.EQ.'A')GO TO 15
05000		IF(P.NE.'C'.AND.P.NE.'D')GO TO 146
05100	110	TYPE 111
05200	111	FORMAT(' TYPE NAME OR IF FINISHED TYPE <CR>.'/)
05300		ACCEPT 9,(NA(I),I=1,11)
05400		IF(NA(1).EQ.' ')GO TO 134
05500		DO 114 N=1,K
05600		J=0
05700		DO 114 I=1,11
05800		IF(JA(I,N).EQ.NA(I))J=J+1
05900		IF(J.EQ.11)GO TO 148
06000	114	CONTINUE
06100		TYPE 116
06200	116	FORMAT(' NAME NOT FOUND.'/)
06300		GO TO 134
06400	148	IF(P.EQ.'D')GO TO 149
06500		NB=1
06600	   	TYPE 117
06700	117	FORMAT(' TYPE NEW NAME OR <CR> FOR NO CHANGE.'/)
06800		ACCEPT 9,(NA(I),I=1,11)
06900		IF(NA(1).EQ.' ')GO TO 119
07000		DO 131 I=1,11
07100	131	JA(I,N)=NA(I)
07200	119	TYPE 136,(JB(I,N),I=1,7)
07300		TYPE 121
07400	121	FORMAT(' TYPE NEW ADDRESS LINE OR <CR> FOR NO CHANGE.'/)
07500		ACCEPT 11,(NA(I),I=1,7)
07600	136	FORMAT(1X7A5)
07700		IF(NA(1).EQ.' ')GO TO 122
07800		DO 123 I=1,7	
07900	123	JB(I,N)=NA(I)
08000	122	TYPE 136,(JC(I,N),I=1,7)
08100		TYPE 121
08200		ACCEPT 11,(NA(I),I=1,7)
08300		IF(NA(1).EQ.' ')GO TO 300
08400		DO 125 I=1,7
08500	125	JC(I,N)=NA(I)
08600	300	TYPE 136,(JE(I,N),I=1,7)
08700		TYPE 121
08800		ACCEPT 11,(NA(I),I=1,7)
08900		IF(NA(1).EQ.' ')GO TO 124
09000		DO 301 I=1,7
09100	301	JE(I,N)=NA(I)
09200	124	TYPE 137,(JD(I,N),I=1,7)
09300	137	FORMAT(1X7A1)
09400		TYPE 127
09500	127	FORMAT(' TYPE NEW LIST NAMES OR <CR> FOR NO CHANGE.'/)
09600		ACCEPT 20,(NA(I),I=1,7)
09700		IF(NA(1).EQ.' ')GO TO 134
09800		DO 129 I=1,7
09900	129	JD(I,N)=NA(I)	
10000		GO TO 134
10100	33	K=K-1
10200	   	P=' '
10300	146	IF(NB.EQ.0)GO TO 132
10400	104	DO 5 N=1,K-1
10500		IF(LN(N).LE.LN(N+1))GO TO 5
10600		DO 27 I=1,11
10700	27	JA(I,K+1)=JA(I,N)
10800		DO 133 I=1,7
10900		JB(I,K+1)=JB(I,N)
11000	  	JC(I,K+1)=JC(I,N)
11100		JE(I,K+1)=JE(I,N)
11200	133	JD(I,K+1)=JD(I,N)
11300	149	DO 82 J=N,K
11400		DO 26 I=1,11
11500	26	JA(I,J)=JA(I,J+1)
11600		DO 47 I=1,7
11700		JB(I,J)=JB(I,J+1)
11800	  	JC(I,J)=JC(I,J+1)
11900		JE(I,J)=JE(I,J+1)
12000	47	JD(I,J)=JD(I,J+1)
12100	82	CONTINUE
12250	       IF(P.NE.'D')GO TO 5
12300		K=K-1
12400		NB=NB+NB
12500		GO TO 134
12600	5	CONTINUE
12700	132	REWIND 1
12800		CALL OFILE(1,F)
12900		WRITE(1)K,((JB(I,L),I=1,7),L=1,K),K
13000		WRITE(1)((JA(I,L),I=1,11),L=1,K),K
13100		WRITE(1)((JC(I,L),I=1,7),L=1,K),K
13200		WRITE(1)((JE(I,L),I=1,7),L=1,K),K
13300		WRITE(1)((JD(I,L),I=1,7),L=1,K),K,K
13400		END FILE 1
13500	60	TYPE 77
13600	77	FORMAT(' TYPE LIST NAME OR <CR> FOR ALL LISTS.'/)
13700		ACCEPT 10,JF
13800		Y=' '
13900	 	IF(JF.EQ.' ')GO TO 53
14000		N=1
14100		DO 99 L=1,K
14200		DO 97 I=1,7
14300		IF(JD(I,L).EQ.JF)GO TO 98
14400	97	CONTINUE
14500		GO TO 99
14600	98	DO 51 M=1,11
14700	51	JA(M,N)=JA(M,L)
14800		DO 100 M=1,7
14900		JB(M,N)=JB(M,L)
15000	   	JC(M,N)=JC(M,L)
15100		JE(M,N)=JE(M,L)
15200	100	JD(M,N)=JD(M,L)
15300		N=N+1
15400	99	CONTINUE
15500		K=N-1
15600	53	Y='Y'
15700	  	TYPE 13
15800	13	FORMAT(' TTY OR LINE PRINTER?'/)
15900		ACCEPT 10,T
16000		IF(T.NE.'L')GO TO 103
16100	  	TYPE 88
16200	88	FORMAT(' PRINT WITH LIST NAMES?'/)
16300		ACCEPT 10,Y
16400	103	LIST=5
16500		IF(T.EQ.'L')LIST=3
16600		WRITE(LIST,91)F,JF
16700	91	FORMAT(//28XA5,' FILE',4XA1,' LIST'/)
16800		ID=1
16900		DO 45 J=1,K,2
17000		IF(K.EQ.J)ID=0
17100		WRITE(LIST,19)((JA(I,L),I=1,11),L=J,J+ID)
17200	19	FORMAT(//2(2X5A1,6A5))
17300		WRITE(LIST,46)((JB(I,L),I=1,7),L=J,J+ID)
17400	46	FORMAT(2(2X7A5))
17500		WRITE(LIST,46)((JC(I,L),I=1,7),L=J,J+ID)
17600		WRITE(LIST,46)((JE(I,L),I=1,7),L=J,J+ID)
17700		IF(Y.NE.'Y')GO TO 45
17800		WRITE(LIST,48)((JD(I,L),I=1,7),L=J,J+ID)
17900	48	FORMAT(/5X7A1,30X7A1)
18000	45	CONTINUE
18100		IF(T.EQ.'L')CALL EXIT
18200		U=1
18300		GO TO 8
18400		END
18500	
18600		FUNCTION LN(M)
18700		MX=100000000
18800		LN=0
18900		DO 1 K=1,5
19000		LN=LN+NU(K,M,MX)
19100	1	MX=MX/100
19200		RETURN
19300		END
19400	
19500		FUNCTION NU(K,M,MX)
19600		COMMON JA(11,200)
19700		NU=(1-('A'-JA(K,M))/536870912)*MX
19800		RETURN
19900		END